home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tp4wio.com / TP4WIO.DOC < prev    next >
Encoding:
Text File  |  1988-08-28  |  15.8 KB  |  317 lines
  1. Tp4wio is a Turbo Pascal Version 4.0 Unit which consists of a
  2. collection of procedures and functions which assist in
  3. screen input/output.  Many other uses in general programming are
  4. available as well.  The strings used are defined as Pascal strings
  5. (string[255]) so you must be careful the string you are using is
  6. suitable for the screen.  This was done to allow the routines to be
  7. used for printer or disk report generation as well as the screen.
  8. NOTE: This Pascal Unit will not work with Turbo Pascal Version 3.x
  9. without a lot of modification.
  10.  
  11. This file contains the interface section of tp4wio.pas which defines
  12. the various routines and has a short comment about each one.
  13.  
  14. All variables must be initialized by the user before calling a routine
  15. in this package or unusual results will happen (normal for Pascal
  16. anyway).
  17.  
  18. The global variables fld and scrn deserve a short mention here, they
  19. are used to allow full screen and multi-screen input.  Each variable
  20. is designed to be used in a repeat -- until loop where they will be
  21. adjusted by the program by the up/down arrow keys and the PgUp/Pgdn
  22. keys.
  23.  
  24. The fld variable is updated after each screen input function (i.e.
  25. read_str, read_int, etc).  Below is a short program fragment to show
  26. how this variable is used.
  27.  
  28. fld := 1;   { expecting to use the first case element }
  29. repeat
  30.    case fld of
  31.       1 :read_int(intvar,3,20,5);
  32.       2 :read_str(name,20,20,6);
  33.       3 :read_str(address,30,20,7);
  34.    end;  {case}
  35. until (fld < 1) or (fld > 3);
  36.  
  37. In the above example the cursor will start at x=20, y=5 and wait for a
  38. 3 character input which will be returned in the integer variable
  39. intvar.  Return or down arrow will accept the input and move to the
  40. next field at x=20, y=6.  Going off the top, off the bottom, Page Up,
  41. or Page Down will terminate the entries and exit the repeat - until
  42. loop.
  43.  
  44. The scrn variable is used in an outer repeat - until loop which calls
  45. inner repeat - until loops (procedures) and allows multi-page input
  46. screens to be built.  The scrn variable is not done automatically but
  47. you must call the procedure do_scrn_ctl to update it to a new value.
  48. Be sure to set the scrn variable to the starting screen before calling
  49. the routine which uses it.
  50.  
  51. The window system is very simple but is adequate for many projects.
  52. There are only 10 windows allowed (though you may change it if
  53. desired) and if an error (invalid screen coordinates) occurs, your
  54. program variable werror will be set to true and the computer will
  55. beep.
  56.  
  57. The endwindows procedure should be placed as the last statment in your
  58. program (if you are using the windows) to insure all windows are
  59. closed.
  60.  
  61. Added the inv_col_flag which is set by the init section and is true if
  62. a color card is found.  Along with this is the inv_color which is set
  63. to green, this color is used instead of inverting the foreground and
  64. background for highlighting.  Both of these may be changed by the user
  65. program.
  66.  
  67. This work has and is released to the Public Domain for whatever
  68. purposes you desire.  Credit has been given to other authors where
  69. needed.  Have fun with it --- Gerry Rohr --- Below is the definition
  70. of all procedures and functions available to the user.
  71.  
  72. unit tp4wio;
  73. {  -- Global I/O procedures to include in programs generally
  74.   Much credit is due Bill Meacham who wrote the original file IO22.INC
  75.   and released it to the public domain.  Using that work this unit was
  76.   created and added to by Gerald Rohr of Homogenized Software.  As
  77.   with Bill's work, this program is released to the Public Domain for
  78.   all to use and modify.
  79.                        REVISION  HISTORY
  80.   ---------------------------------------------------------------------
  81.   Ver 2.22 - Converted to a Turbo pascal V4 units.        30 Dec 87 gbr
  82.   Ver 2.30 - Converted dates to longint types             19 Jan 88 gbr
  83.   Ver 2.42 - Added global inv_flag for all write routines 08 Apr 88 gbr
  84.   Ver 2.43 - Added long integer read and write routines   01 May 88 gbr
  85.   Ver 2.43 - Added month and month/day routines           10 May 88 gbr
  86.   Ver 3.00 - Replaced Window procedures/Reformated file   15 Jul 88 gbr
  87.   Ver 3.10 - Moved Window error routines here             26 Aug 88 gbr
  88.   Ver 3.20 - Added code and globals for color hi lights   27 Aug 88 gbr
  89.   --------------------------------------------------------------------- }
  90.  
  91. interface
  92.  
  93. uses
  94.    crt,dos;
  95.  
  96. const
  97.    fdslen     = 29 ;  { length of fulldatestring }
  98.  
  99. type
  100.    datestring = string[10] ;  { 'MM/DD/YYYY' }
  101.  
  102.    fulldatestring = string[fdslen] ;
  103.  
  104.    juldate = record
  105.       yr  : integer ; { 0 .. 9999 }
  106.       day : integer ; { 1 .. 366 }
  107.    end ;
  108.  
  109.    juldatestring = string[8] ; { 'YYYY/DDD' }
  110.  
  111.    montharray = array [1 .. 13] of integer ;
  112.  
  113.    intst     = string[2];                   { string of an integer }
  114.  
  115. var
  116.    sys_date      :longint;
  117.    null_date     :longint;
  118.    null_date_str : datestring;
  119.  
  120.    fld, scrn     : integer ; { For field & screen cursor control }
  121.    macro         :array[1..10] of string; { Function key macro storage }
  122.    inv_flag      :boolean;  { if true all write routines inverse the screen,
  123.                               set to false by initialization. User uses
  124.                               this flag to control the screen attributes.}
  125.    col_inv_flag  :boolean;  { true if color monitor, false if monochrome,
  126.                               set by initialization routine,  User may change. }
  127.    inv_color     :byte;     { color to use for inverse data if col_inv_flag
  128.                               is true. Defaults to green, but user may change. }
  129.    in_window     :boolean;  { if true then we are in a window, used by the
  130.                               screen writing routines to high light screen
  131.                               data.  NOTE high lighting can only be done when
  132.                               in_window flag is true. }
  133.    reserv_wind   :integer;  { number of windows to reserve (not close) with
  134.                               endwindows procedure.  Initialized to 0, use
  135.                               with multiple program files. }
  136.  
  137. PROCEDURE CLRLINE (col,row : integer);
  138. PROCEDURE BEEP ;
  139. PROCEDURE DO_FLD_CTL (key : integer);
  140.          { Adjusts global FLD based on value of key, the ordinal value
  141.            of last key pressed }
  142. PROCEDURE DO_SCRN_CTL ;
  143.          { Checks value of FLD and adjusts value of SCRN accordingly }
  144. PROCEDURE WRITE_STR (st:string ; col,row:integer);
  145. PROCEDURE WRITE_TEMP(var ln:string;tmp:string;x,y:integer);
  146.          { writes a string using a template.  the string (ln) is printed
  147.            left justified in the template using the filler locations.
  148.            quits when the template is complete on the screen.  Fills unused
  149.            template filler locations with space. }
  150. PROCEDURE WRITE_INT (i:integer ; width,col,row:integer);
  151. PROCEDURE WRITE_LINT(lint:longint;width,col,row:integer);
  152. PROCEDURE SET_BOOL (var bool : boolean);
  153.          { Sets boolean to be undefined, neither true nor false.
  154.            Boolean is stored as one byte:
  155.                $80 = undefined
  156.                $01 = true
  157.                $00 = false.
  158.            Note : Turbo interprets $80 as true because it is greater than zero! }
  159. FUNCTION DEFINED (bool : boolean) : boolean ;
  160.          { Determines whether the boolean is defined or not }
  161. PROCEDURE WRITE_BOOL (bool:boolean ; col, row:integer);
  162. PROCEDURE WRITE_REAL (r:real ; width,frac,col,row:integer);
  163. FUNCTION BUILD_STR (ch : char ; n : integer) : string ;
  164.          { returns a string of length n of the character ch }
  165. FUNCTION PAD (st : string ; ch : char ; i : integer) : string ;
  166.          { Pad string with ch to length of i. }
  167. FUNCTION UPPER (st :string):string;
  168.          { returns upper case of st }
  169. FUNCTION STRIPCH (instr:string ; inchar:char) : string ;
  170.          {Strips leading instances of the character from the string}
  171. FUNCTION TRIM (st:string;len:integer):string;
  172.          { Chops spaces from string or truncates at l length }
  173. FUNCTION CHOPCH (instr:string ; inchar:char) : string ;
  174.          {Chops trailing instances of the character from the string}
  175. FUNCTION INTTOSTR(n:integer):intst;
  176.          { converts integer to packed two char string }
  177. FUNCTION STRTOINT(s:intst):integer;
  178.          { converts packed two char string to integer }
  179. PROCEDURE READ_STR (var st:string ; maxlen, col, row:integer);
  180.          { Read String.  This procedure gets input from the keyboard one
  181.            character at a time and edits on the fly, rejecting invalid
  182.            characters.  COL and ROW tell where to begin the data input
  183.            field, and MAXLEN is the maximum length of the string to be
  184.            returned.
  185.            Only use the Function keys for string input data, for other
  186.            types of input will beep. }
  187. PROCEDURE READ_TEMP(var st:string;tmp:string;col, row:integer);
  188.            { Read string with a template.  This procedure gets input from
  189.            the keyboard one character at a time and edits on the fly,
  190.            rejecting invalid characters.  tmp is a template which is filled
  191.            in where filler characters exist, any other characters are displayed
  192.            on the screen.  Returned string does NOT have the template imbeded in
  193.            it.  COL and ROW tell where to begin the data input
  194.            field, Max length of the string is the max length of the template.
  195.            }
  196. PROCEDURE READ_INT (var int:integer ; maxlen, col, row:integer);
  197.          { Read Integer.  This procedure gets input from the keyboard
  198.            one character at a time and edits on the fly, rejecting
  199.            invalid characters.  COL and ROW tell where to begin the data
  200.            input field, and MAXLEN is the maximum length of the integer
  201.            to be returned. }
  202. PROCEDURE READ_LINT (var lint:longint ; maxlen, col, row:integer);
  203.          { Read LongInt.  This procedure gets input from the keyboard
  204.            one character at a time and edits on the fly, rejecting
  205.            invalid characters.  COL and ROW tell where to begin the data
  206.            input field, and MAXLEN is the maximum length of the integer
  207.            to be returned. }
  208. FUNCTION EQUAL (r1,r2 : real) : boolean ;
  209.          { tests functional equality of two real numbers -- 4/30/85 }
  210. FUNCTION GREATER (r1,r2 : real) : boolean ;
  211.          { tests functional inequality of two real numbers -- 5/1/85 }
  212. PROCEDURE READ_REAL (var r:real ; maxlen,frac,col,row:integer);
  213.          { Read Real.  This procedure gets input from the keyboard
  214.            one character at a time and edits on the fly, rejecting
  215.            invalid characters.  COL and ROW tell where to begin the data
  216.            input field; MAXLEN is the maximum length of the string
  217.            representation of the real number, including sign and decimal
  218.            point; FRAC is the fractional part, the number of digits to
  219.            right of the decimal point.
  220.  
  221.            Note -- In Turbo the maximum number of significant digits in
  222.            decimal (not scientific) representation is 11.  In TurboBCD,
  223.            the maximum number of significant digits is 18.  It is the
  224.            programmer's responsibility to limit input and computed output
  225.            to the maximum significant digits. }
  226. PROCEDURE READ_YN (var bool:boolean; col,row:integer);
  227.          { Inputs "Y" OR "N" to boolean at column and row specified,
  228.            prints "YES" or "NO."
  229.            Note -- use this when the screen control will not return
  230.            to the question and the boolean IS NOT defined before the
  231.            user answers the question.  Does not affect global FLD. }
  232. PROCEDURE READ_BOOL (var bool:boolean; col,row:integer);
  233.          { Displays boolean at column and row specified, inputs "Y"
  234.            or "N" to set new value of boolean, prints "YES" or "NO."
  235.            Boolean is "forced;" user cannot cursor forward past undefined
  236.            boolean.  Pressing "Y" or "N" terminates entry.
  237.            Boolean is stored as one byte:
  238.                $80 = undefined
  239.                $01 = true
  240.                $00 = false.
  241.            Note : Turbo interprets $80 as true because it is greater
  242.            than zero! }
  243. PROCEDURE PAUSE ;
  244.          {Prints message on bottom line, waits for user response.
  245.           Changed from line 24 to line 23 for windows  gbr}
  246. PROCEDURE HARD_PAUSE ;
  247.          { Like Pause, but only accepts space bar or Escape and only
  248.            goes forward. Changed from line 24 to line 23 for windows.  gbr }
  249. PROCEDURE SHOW_MSG (msg : string);
  250.          { Beeps, displays message centered on line 22, pauses }
  251.          { changed from line 23 to line 22 for windows. gbr }
  252. FUNCTION MK_DT_ST (dt :longint) : datestring ;
  253.          { Makes a string out of a date -- used for printing dates }
  254. PROCEDURE WRITE_DATE (dt: longint ; col, row: integer);
  255.          { Writes date at column and row specified }
  256. FUNCTION MK_JUL_DT_ST (jdt : juldate) : juldatestring ;
  257.          { makes a string out of a julian date }
  258. PROCEDURE READ_DATE (var dt: longint ; col, row: integer);
  259.          { Read date at column and row specified.  If the user enters
  260.            only two digits for the year, the procedure plugs the
  261.            century as 1900 or 2000, but the user can enter all four
  262.            digits to override the plug. }
  263. FUNCTION GREATER_DATE (dt1, dt2 : longint) : integer ;
  264.          { Compares two dates, returns 0 if both equal, 1 if first is
  265.            greater, 2 if second is greater. }
  266. PROCEDURE GREG_TO_JUL (dt : longint ; var jdt : juldate);
  267.          { converts a gregorian date to a julian date }
  268. PROCEDURE JUL_TO_GREG (jdt : juldate ; var dt : longint);
  269.          { converts a julian date to a gregorian date }
  270. PROCEDURE NEXT_DAY (var dt : longint);
  271.          { Adds one day to the date }
  272. PROCEDURE PREV_DAY (var dt : longint);
  273.          { Subtracts one day from the date }
  274. FUNCTION DATE_DIFF (dt1, dt2 : longint) : longint ;
  275.          { computes the number of days between two dates }
  276. FUNCTION MONTH_DIFF (dt1, dt2 : longint ) : integer ;
  277.          { Computes number of months between two dates, rounded.
  278.            30.4167 = 356/12, average number of days in a month. }
  279. FUNCTION EQUAL_DATE (dt1, dt2 : longint) : boolean ;
  280.          { Tests whether two dates are equal }
  281. FUNCTION BUILD_FULL_DATE_STR (dt : longint) : fulldatestring ;
  282.          { Build printable string of current date -- from ROS 3.4
  283.            source code. }
  284. FUNCTION MONTH(dt:longint):integer;
  285.          { returns the month portion of a date.}
  286. FUNCTION DAY(dt:longint):integer;
  287.          { returns the day from the date }
  288. FUNCTION YEAR(dt:longint;centry:boolean):integer;
  289.          { returns the year of a date.  if the centry flag is true
  290.            returns 4 digit year otherwise returns two digit year. }
  291.  
  292. { ---- window procedures Derived from article in Computer Language
  293.   Magazine June 1988 by James Kerr ---- }
  294.  
  295. PROCEDURE OPENWINDOW(wtitle:string;x1,y1,x2,y2:byte;
  296.                      fgnd,bkgnd: byte);
  297.          { wtitle is centered on the top border line of the window, x
  298.          and y are the window coordinates, fgnd and bkgnd are the
  299.          colors of the inside of the window (note the border is always
  300.          white, if a window can not be opened, a message as to why will
  301.          be displayed and the program exits
  302.          }
  303. PROCEDURE CLOSEWINDOW;
  304.          { closes the current open window, does nothing if no
  305.            window to close. }
  306. PROCEDURE ENDWINDOWS;
  307.          { close any open windows when exiting the windows system.  Use
  308.            as the last statment in program to insure return to
  309.            enviroment you came from.  The global reserv_wind is normally
  310.            set to 0 allowing all windows to be closed, if using a
  311.            multi file window program, reserv_wind can be set to the
  312.            number of windows to be left open when a particular program
  313.            terminates.  Always set reserv_wind to 0 before the final
  314.            program call to endwindows.
  315.          }
  316. { ---------------------------------------------------------------- }
  317.